home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 22 Graphics & Utilities / FRACTA.BIN (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  4.3 KB  |  156 lines
  1. 0 (null)FOR0,,,,0:(null)END1,"GRAPHIC0"+CHR$(13):(null)END3,"GRAPHIC1"+CHR$(13)
  2. 1 PRINT"[147] [176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  3. 2 PRINT" [194]                                  [194]"
  4. 3 PRINT" [194]      FRACTAL LANDSCAPES V1.0     [194]"
  5. 4 PRINT" [194]                                  [194]"
  6. 6 PRINT" [173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]"
  7. 7 IN%=0:INPUT"       [154]INSTRUCTIONS (1=YES)";IN%
  8. 8 IFIN%=1THENGOSUB2000
  9. 9 INPUT"       [154]1520 PLOTTER (Y/N)";PL$
  10. 19 IFPL$="Y"THEN:OPEN2,6,2:OPEN3,6,2:OPEN4,6,0:OPEN1,6,1
  11. 20 DIMD(64,32):INPUT"       NUMBER OF LEVELS (1-6)";LE
  12. 40 DS=2:FORN=1TOLE:DS=DS+2^(N-1):NEXTN
  13. 50 MX=DS-1:MY=MX/2:PI=(null):RH=PI*30/180:VT=RH*1.2
  14. 60 FORN=1TOLE:L=10000/1.8^N
  15. 70 PRINT"       WORKING ON LEVEL";N
  16. 80 IB=MX/2^N:SK=IB*2
  17. 90 GOSUB150:REM  *** HEIGHTS ALONG X
  18. 100 GOSUB220:REM *** HEIGHTS ALONG Y
  19. 110 GOSUB290:REM *** HEIGHTS ALONG DIAG.
  20. 120 NEXTN
  21. 125 (null)NEXT1,1
  22. 130 GOTO640:REM *** DRAW
  23. 140 REM*** HEIGHTS ALONG X
  24. 150 FORYE=0TOMX-1STEPSK
  25. 160 FORXE=IB+YETOMXSTEPSK
  26. 170 AX=XE-IB:AY=YE:GOSUB370:D1=D:AX=XE+IB:GOSUB370:D2=D
  27. 180 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB420
  28. 190 NEXTXE
  29. 200 NEXTYE:RETURN
  30. 210 REM *** HEIGHTS ALONG Y
  31. 220 FORXE=MXTO1STEP-SK
  32. 230 FORYE=IBTOXESTEPSK
  33. 240 AX=XE:AY=YE+IB:GOSUB370:D1=D:AY=YE-IB:GOSUB370:D2=D
  34. 250 D=(D1+D2)/2+RND(1)*L/2-L/4:AX=XE:AY=YE:GOSUB420
  35. 260 NEXTYE
  36. 270 NEXTXE:RETURN
  37. 280 REM *** HEIGHTS ALONG DIAG.
  38. 290 FORXE=0TOMX-1STEPSK
  39. 300 FORYE=IBTOMX-XESTEPSK
  40. 310 AX=XE+YE-IB:AY=YE-IB:GOSUB370:D1=D
  41. 320 AX=XE+YE+IB:AY=YE-IB:GOSUB370:D2=D
  42. 330 AX=XE+YE:AY=YE:D=(D1+D2)/2+RND(1)*L/2-L/4:GOSUB420
  43. 340 NEXTYE
  44. 350 NEXTXE:RETURN
  45. 360 REM *** RETURN DATA FROM ARRAY
  46. 370 IFAY>MYTHEN390
  47. 380 BY=AY::BX=AX:GOTO400
  48. 390 BY=MX+1-AY:BX=MX-AX
  49. 400 D=D(BX,BY):RETURN
  50. 410 REM *** PUT DATA INTO ARRAY
  51. 420 IFAY>MYTHEN440
  52. 430 BY=AY:BX=AX:GOTO450
  53. 440 BY=MX+1-AY:BX=MX-AX
  54. 450 D(BX,BY)=D:RETURN
  55. 460 REM *** PUT IN SEA LEVEL
  56. 470 IFXO<>-999THEN500
  57. 480 IFZZ<0THENGOSUB1070:Z2=ZZ:ZZ=0:GOTO620
  58. 490 GOSUB1090:GOTO610
  59. 500 IFZ2>0ANDZZ>0THEN610
  60. 510 IFZ2<0ANDZZ<0THENZ2=ZZ:ZZ=0:GOTO620
  61. 520 W3=ZZ/(ZZ-Z2):X3=(X2-XX)*W3+XX:Y3=(Y2-YY)*W3+YY:Z3=0
  62. 530 ZT=ZZ:YT=YY:XT=XX
  63. 540 IFZZ>0THEN590
  64. 550 REM *** GOING INTO WATER
  65. 560 ZZ=Z3:YY=Y3:XX=X3:GOSUB950
  66. 570 GOSUB1070:ZZ=0:YY=YT:XX=XT:Z2=ZT:GOTO620
  67. 580 REM *** GOING OUT OF WATER
  68. 590 ZZ=Z3:YY=Y3:XX=X3:GOSUB950
  69. 600 GOSUB1090:ZZ=ZT:YY=YT:XX=XT
  70. 610 Z2=ZZ
  71. 620 X2=XX:Y2=YY:RETURN
  72. 630 REM *** DISPLAY HERE
  73. 640 GOSUB1110:REM *** SET UP SCREEN
  74. 650 XS=.03:YS=.02 :ZS=.1:REM *** SCALING FACTORS
  75. 660 FORAX=0TOMX:XO=-999:FORAY=0TOAX
  76. 670 GOSUB370:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2
  77. 680 GOSUB940:NEXTAY:NEXTAX
  78. 690 FORAY=0TOMX:XO=-999:FORAX=AYTOMX
  79. 700 GOSUB370:ZZ=D:YY=AY/MX*10000:XX=AX/MX*10000-YY/2
  80. 710 GOSUB940:NEXTAX:NEXTAY
  81. 720 FOREX=0TOMX:XO=-999:FOREY=0TOMX-EX
  82. 730 AX=EX+EY:AY=EY:GOSUB370:ZZ=D:YY=AY/MX*10000
  83. 740 XX=AX/MX*10000-YY/2:GOSUB940:NEXTEY:NEXTEX
  84. 750 GOTO1130:REM *** END
  85. 760 REM *** ROTATE
  86. 770 IFXX<>0THEN800
  87. 780 IFYY<=0THENRA=RA-PI/2:GOTO820
  88. 790 RA=PI/2:GOTO820
  89. 800 RA=ATN(YY/XX)
  90. 810 IFXX<0THENRA=RA+PI
  91. 820 R1=RA+RH:RD=SQR(XX*XX+YY*YY)
  92. 830 XX=RD*COS(R1):YY=RD*SIN(R1)
  93. 840 RETURN
  94. 850 REM *** TILT DOWN
  95. 860 RD=SQR(ZZ*ZZ+XX*XX)
  96. 870 IFXX=0THENRA=PI/2:GOTO900
  97. 880 RA=ATN(ZZ/XX)
  98. 890 IFXX<0THENRA=RA+PI
  99. 900 R1=RA-VT
  100. 910 XX=RD*COS(R1)+XX:ZZ=RD*SIN(R1)
  101. 920 RETURN
  102. 930 REM *** MOVE OR PLOT TO (XP,YP)
  103. 940 GOSUB470
  104. 950 XX=XX*XS:YY=YY*YS:ZZ=ZZ*ZS
  105. 960 GOSUB770:REM *** ROTATE
  106. 970 GOSUB860:REM *** TILT UP
  107. 980 IFXO=-999THENPR$="M"
  108. 985 IFXO<>-999THENPR$="D"
  109. 990 XP=INT(YY)+CX:YP=INT(ZZ)
  110. 1000 GOSUB1030
  111. 1010 RETURN
  112. 1020 REM *** PLOT LINE HERE
  113. 1030 XP=XP*.625:YP=33.14-.663*YP
  114. 1040 IFPR$="M"THENX8=XP:Y8=YP:XO=X
  115. 1050 (null)GOTOAT,X8+2,Y8+60 TO XP+2,YP+60
  116. 1055 IFPL$="Y"THEN:PRINT#1,"M";INT(X8*3.01257862),ABS(INT(Y8*2.40703158)-479)
  117. 1056 IFPL$="Y"THEN:PRINT#1,"D";INT(XP*3.01257862),ABS(INT(YP*2.40703158)-479)
  118. 1057 X8=XP:Y8=YP:RETURN
  119. 1060 REM *** SWITCH TO SEA COLOR
  120. 1070 AT=2:IFPL$="Y"THENPRINT#2,1
  121. 1075 RETURN
  122. 1080 REM *** SWITCH TO LAND COLOR
  123. 1090 AT=3:IFPL$="Y"THENPRINT#2,2
  124. 1095 RETURN
  125. 1100 REM *** SET UP SCREEN
  126. 1110 PRINT"[147]":(null)NEXT1:(null)FOR0,12,6,5,0
  127. 1112 IF PL$="Y"THEN:FORJP=1TO24:PRINT#4:NEXT
  128. 1113 RETURN
  129. 1120 REM *** END LOOP
  130. 1130 GETA$:IFA$=""THEN:GOTO1130
  131. 1135 (null)NEXT0
  132. 1140 END
  133. 2000 PRINT"[147]  [154][176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  134. 2002 PRINT"  [194]                                  [194]"
  135. 2003 PRINT"  [194]           INSTRUCTIONS           [154][194]"
  136. 2004 PRINT"  [194]                                  [194]"
  137. 2006 PRINT"  [173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]"
  138. 2008 PRINT"  PROGRAM WILL PLOT A FRACTAL LANDSCAPE
  139. 2009 [153]"  CONTAINING LAND AND WATER AREAS.
  140. 2010 PRINT"  EACH TIME THE PROGRAM RUNS DIFFERENT
  141. 2011 [153]"  RANDOM LANDSCAPES ARE DRAWN.
  142. 2012 PRINT"    LEVELS  [146] - THERE ARE SIX LEVELS OF
  143. 2013 [153]"  MAPMAKING. THE HIGHER THE NUMBER THE
  144. 2014 PRINT"  HIGHER THE RESOLUTION OF THE MAP.
  145. 2015 [153]"  HIGHER RESOLUTION LEVELS WILL TAKE
  146. 2016 PRINT"  LONGER TO MAP. AT LEVELS 4 OR HIGHER
  147. 2017 [153]"  YOU CAN TAKE A NAP AND WAIT.
  148. 2018 PRINT"          HIT A KEY TO CONTINUE   [146]"
  149. 2019 GETK$:IFK$=""THEN2019
  150. 2020 PRINT"[147] [176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  151. 2021 PRINT" [194]                                  [194]"
  152. 2023 PRINT" [194]      FRACTAL LANDSCAPES V1.0     [194]"
  153. 2024 PRINT" [194]                                  [194]"
  154. 2026 PRINT" [173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]"
  155. 2999 RETURN
  156.